home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.20 / rrequest / rrequest.i < prev    next >
Text File  |  1995-04-22  |  5KB  |  163 lines
  1. Uses INTUITION;
  2. {$ if not def RREQUEST_H} CONST RREQUEST_H=0;
  3. {$ if not def LIBRARIES_ASL_H;INCL 'libraries/asl.h';endif}
  4. {$ if not def ASL_LIB_H;INCL 'asl.lib';endif}
  5. {$ if not def EXEC_LIB_H;INCL 'exec.lib';endif}
  6.  
  7. VAR   ok,foundasl,foundarp:BOOLEAN;STATIC;
  8.       ait1,ait2,ait3,aja:Intuitext;
  9.       f:FILE;
  10.  
  11.  
  12. Type
  13.   arpFileRequester = Record
  14.                     FR_Hail      : Str;
  15.                     FR_File      : Str;
  16.                     FR_Dir       : Str;
  17.                     FR_Window    : Ptr;
  18.                     FR_FuncFlags : Byte;
  19.                     FR_Reserved1 : Byte;
  20.                     FR_Function  : Ptr;
  21.                     FR_Reserved2 : Long
  22.                   End;
  23.  
  24. Var ARPBase : Ptr;
  25.  
  26. Library ARPBase:
  27.  -294: Function FileRequest (a0: Ptr) : Long
  28. End;
  29.  
  30. FUNCTION OS2:BOOLEAN;
  31.  VAR lib:p_library;
  32.  BEGIN
  33.   lib:=intuitionbase;
  34.   OS2:=(lib^.lib_version>=36);
  35.  END;
  36.  
  37. PROCEDURE searchlibs;
  38. BEGIN
  39.  foundasl:=FALSE;
  40.  foundarp:=FALSE;
  41.  reset(f,'sys:libs/asl.library');
  42.  IF IORESULT=0 THEN
  43.   BEGIN
  44.    IF OS2 THEN foundasl:=TRUE
  45.           ELSE foundasl:=FALSE;
  46.    close(f);
  47.   END;
  48.  reset(f,'sys:libs/arp.library');
  49.  IF IORESULT=0 THEN
  50.   BEGIN
  51.    foundarp:=TRUE;
  52.    close(f);
  53.   END;
  54. END;
  55.  
  56. Procedure Filereq(Title:STRING; VAR FR_File,FR_Dir:STRING);
  57.   VAR
  58.     FR : arpFileRequester;
  59.   Begin
  60.    OpenLib (ARPBase, 'arp.library', 0);
  61.    FR_File:='';
  62.    IF  (FR_Dir[(strlen(FR_Dir))]='/') THEN FR_Dir[STRLEN(FR_Dir)]:=CHR(0);
  63.    FR := arpFileRequester(Title,FR_File,FR_Dir,NIL,0,0,Nil,0);
  64.    If FileRequest(^FR)<>0 Then
  65.     Begin
  66.      IF (pos(":",FR_Dir)<>Strlen(FR_Dir)) AND (FR_Dir[(strlen(FR_Dir))]<>'/')
  67.      THEN FR_Dir:=FR_Dir+"/";
  68.     End
  69.    Else
  70.    fr_File:='';
  71.  End;
  72.  
  73. PROCEDURE noaslmessage;
  74.  BEGIN
  75.    ait1:=INTUITEXT(2,1,0,10,10,NIL,' Kann asl.library nicht finden',^ait2);
  76.    ait2:=INTUITEXT(2,1,0,10,20,NIL,'      !  A C H T U N G  !',^ait3);
  77.    ait3:=INTUITEXT(2,1,0,14,30,NIL,'Kein asl-Filerequester möglich',NIL);
  78.    aja:=INTUITEXT(2,1,0,5,3,NIL,'            Schade !          ',NIL);
  79.    ok:=AUTOREQUEST(NIL,^ait1,NIL,^aja,0,0,350,65);
  80.  END;
  81.  
  82. PROCEDURE noarpmessage;
  83.  BEGIN
  84.    ait1:=INTUITEXT(2,1,0,10,10,NIL,' Kann arp.library nicht finden',^ait2);
  85.    ait2:=INTUITEXT(2,1,0,10,20,NIL,'      !  A C H T U N G  !',^ait3);
  86.    ait3:=INTUITEXT(2,1,0,14,30,NIL,'Kein arp-Filerequester möglich',NIL);
  87.    aja:=INTUITEXT(2,1,0,5,3,NIL,'            Schade !          ',NIL);
  88.    ok:=AUTOREQUEST(NIL,^ait1,NIL,^aja,0,0,350,65);
  89.  END;
  90.  
  91. PROCEDURE norequestermessage(Text:STR);
  92.  VAR hilf:INTEGER;
  93.  BEGIN
  94.    IF (length(text)>30) THEN
  95.     BEGIN
  96.      hilf:=length(text) SHL 2;
  97.      ait1:=INTUITEXT(2,1,0,hilf-118,10,NIL,'      !  A C H T U N G  !',^ait2);
  98.      ait2:=INTUITEXT(2,1,0,hilf-110,20,NIL,'Konnte keinen Requester öffnen',^ait3);
  99.      ait3:=INTUITEXT(2,1,0,10,30,NIL,Text,NIL);
  100.      aja:=INTUITEXT(2,1,0,5,3,NIL,'          OK         ',NIL);
  101.      ok:=AUTOREQUEST(NIL,^ait1,NIL,^aja,0,0,350,65);
  102.     END
  103.    ELSE
  104.     BEGIN
  105.      ait1:=INTUITEXT(2,1,0,10,10,NIL,'      !  A C H T U N G  !',^ait2);
  106.      ait2:=INTUITEXT(2,1,0,10,20,NIL,'Konnte keinen Requester öffnen',^ait3);
  107.      ait3:=INTUITEXT(2,1,0,130-(length(text) SHL 2),30,NIL,Text,NIL);
  108.      aja:=INTUITEXT(2,1,0,5,3,NIL,'          OK         ',NIL);
  109.      ok:=AUTOREQUEST(NIL,^ait1,NIL,^aja,0,0,350,65);
  110.     END;
  111.  END;
  112.  
  113. PROCEDURE rrequest(Titel:String;VAR Filename,Dirname:String);
  114. VAR Req : p_Filerequester;
  115.     Tags: ARRAY [0..5] OF Tagitem;
  116.     b:BOOLEAN;
  117.  
  118.  BEGIN                          {1}
  119.   IF foundasl THEN
  120.   BEGIN
  121.    OpenLib(AslBase,ASLNAME,36);
  122.    IF aslbase<>NIL THEN
  123.    BEGIN
  124.     IF Dirname='' THEN Dirname:=':';
  125.     tags[0].ti_tag:=ASL_Hail;
  126.     tags[0].ti_Data:=titel;
  127.     tags[1].ti_tag:=ASL_File;
  128.     tags[1].ti_Data:=Filename;
  129.     tags[2].ti_tag:=ASL_Dir;
  130.     tags[2].ti_Data:=Dirname;
  131.     tags[3]:=tagitem(ASL_Width,280);
  132.     tags[4]:=tagitem(ASL_Topedge,40);
  133.     tags[5].ti_tag:=TAG_Done;
  134.     Req:=AllocAslRequest(ASL_Filerequest,^tags);
  135.     IF req<>NIL THEN
  136.     BEGIN                         {2}
  137.      b:=aslrequest(req,^tags);
  138.      IF b=FALSE THEN
  139.       BEGIN                       {3}
  140.        Filename:=req^.rf_File;
  141.        Dirname:=req^.rf_Dir;
  142.        IF (Dirname[length(dirname)]<>':') AND (Dirname[length(dirname)]<>'/')
  143.         THEN Dirname:=Dirname+'/';
  144.       END;                        {3}
  145.       FreeAslRequest(req);
  146.      END                          {2}
  147.      ELSE displaybeep(NIL);
  148.     Closelib(AslBase);
  149.    END;
  150.   END                            {1}
  151.   ELSE   { arprequester }
  152.   BEGIN
  153.    IF foundarp THEN
  154.    BEGIN
  155.     Filereq(titel,Filename,Dirname);
  156.    END
  157.    ELSE noarpmessage;
  158.   END;
  159.  END;
  160.  
  161. {$endif}
  162.  
  163.